home *** CD-ROM | disk | FTP | other *** search
/ IRIS Performer 2.2 Friends Demo / SGI IRIS Performer 2.2 Friends Demo.iso / friends / openworlds / tix / NoteBook.tcl < prev    next >
Text File  |  1997-11-22  |  8KB  |  328 lines
  1. # tixNoteBook --
  2. #
  3. #    NoteBook type of window.
  4. #
  5. #
  6. tixWidgetClass tixNoteBook {
  7.     -classname TixNoteBook
  8.     -superclass tixVStack
  9.     -method {
  10.     pagecget pageconfigure 
  11.     }
  12.     -flag {
  13.     }
  14.     -configspec {
  15.     {-takefocus takeFocus TakeFocus 0} 
  16.     }
  17.     -default {
  18.     {.Background        #d9d9d9}
  19.     {.nbframe.tabPadX    5}
  20.     {.nbframe.tabPadY    4}
  21.     {.nbframe.borderWidth    2}
  22.     {.nbframe.Background    #d9d9d9}
  23.     {*nbframe.relief    raised}
  24.     {*nbframe.font        -Adobe-Helvetica-Bold-R-Normal--*-120-*}
  25.     {.nbframe.inactiveBackground    #c3c3c3}
  26.     }
  27. }
  28.  
  29. proc tixNoteBook::InitWidgetRec {w} {
  30.     upvar #0 $w data
  31.  
  32.     tixChainMethod $w InitWidgetRec
  33.  
  34.     set data(pad-x1) 0
  35.     set data(pad-x2) 0
  36.     set data(pad-y1) 20
  37.     set data(pad-y2) 0
  38. }
  39.  
  40. proc tixNoteBook::ConstructWidget {w} {
  41.     upvar #0 $w data
  42.  
  43.     set data(w:top) [tixNoteBookFrame $w.nbframe -slave 1 -takefocus 1]
  44.     set data(w:nbframe) $data(w:top)
  45.  
  46.     bind $data(w:top) <ButtonPress-1> "tixNoteBook::MouseDown $w %x %y"
  47.     bind $data(w:top) <ButtonRelease-1> "tixNoteBook::MouseUp $w %x %y"
  48.  
  49.     bind $data(w:top) <B1-Motion> "tixNoteBook::MouseDown $w %x %y"
  50.     bind $data(w:top) <ButtonRelease-1> "tixNoteBook::Activate $w %x %y"
  51.  
  52.     bind $data(w:top) <Left>  "tixNoteBook::FocusNext $w prev"
  53.     bind $data(w:top) <Right> "tixNoteBook::FocusNext $w next"
  54.  
  55.     bind $data(w:top) <Return> "tixNoteBook::SetFocusByKey $w"
  56.     bind $data(w:top) <space>  "tixNoteBook::SetFocusByKey $w"
  57. }
  58.  
  59. #----------------------------------------------------------------------
  60. # Public methods
  61. #----------------------------------------------------------------------
  62. proc tixNoteBook::pageconfigure {w child args} {
  63.     upvar #0 $w data
  64.  
  65.     if {![info exists data($child,label)]} {
  66.     error "page \"$child\" does not exist in $w"
  67.     }
  68.  
  69.     set len [llength $args]
  70.     if {$len == 1} {
  71.     case [lindex $args 0] {
  72.         -createcmd {
  73.         return "-createcmd {} {} {} $data($child,createcmd)"
  74.         }
  75.         -raisecmd {
  76.         return "-raisecmd {} {} {} $data($child,raisecmd)"
  77.         }
  78.         default {
  79.         return [$data(w:top) pageconfigure $child [lindex $args 0]]
  80.         }
  81.     }
  82.     }
  83.  
  84.     if {$len == 0} {
  85.     set value [$data(w:top) pageconfigure $child]
  86.     lappend value "-createcmd {} {} {} $data($child,createcmd)"
  87.     lappend value "-raisecmd {} {} {} $data($child,raisecmd)"
  88.     return $value
  89.     }
  90.  
  91.     # By default handle each of the options
  92.     #
  93.     set opt(-createcmd)  $data($child,createcmd)
  94.     set opt(-raisecmd)   $data($child,raisecmd)
  95.     set opt(-label)      $data($child,label)
  96.  
  97.     tixHandleOptions -nounknown opt {-createcmd -raisecmd -label} $args
  98.  
  99.     set data($child,label)     $opt(-label)
  100.     set data($child,raisecmd)  $opt(-raisecmd)
  101.     set data($child,createcmd) $opt(-createcmd)
  102.  
  103.     set new_args {}
  104.     tixForEach {flag value} $args {
  105.     if {$flag != "-createcmd" && $flag != "-raisecmd"} {
  106.         lappend new_args $flag
  107.         lappend new_args $value
  108.     }
  109.     }
  110.  
  111.     if {[llength $new_args] >= 2} {
  112.     return [eval $data(w:top) pageconfig $child $new_args]
  113.     }
  114. }
  115.  
  116. proc tixNoteBook::pagecget {w child option} {
  117.     upvar #0 $w data
  118.  
  119.     if {![info exists data($child,label)]} {
  120.     error "page \"$child\" does not exist in $w"
  121.     }
  122.  
  123.     case $option {
  124.     -createcmd {
  125.         return "-createcmd {} {} {} $data($child,createcmd)"
  126.     }
  127.     -raisecmd {
  128.         return "-raisecmd {} {} {} $data($child,raisecmd)"
  129.     }
  130.     default {
  131.         return [$data(w:top) pageconfigure $child $option]
  132.     }
  133.     }
  134. }
  135.  
  136. proc tixNoteBook::add {w child args} {
  137.     upvar #0 $w data
  138.  
  139.     set ret [eval tixChainMethod $w add $child $args]
  140.  
  141.     set new_args {}
  142.     tixForEach {flag value} $args {
  143.     if {$flag != "-createcmd" && $flag != "-raisecmd"} {
  144.         lappend new_args $flag
  145.         lappend new_args $value
  146.     }
  147.     }
  148.  
  149.     eval $data(w:top) add $child $new_args
  150.  
  151.     return $ret
  152. }
  153.  
  154. proc tixNoteBook::raise {w child} {
  155.     upvar #0 $w data
  156.  
  157.     tixChainMethod $w raise $child
  158.  
  159.     if {[$data(w:top) pagecget $child -state] == "normal"} {
  160.     $data(w:top) activate $child
  161.     focus $data(w:top)
  162.  
  163.     }
  164. }
  165.  
  166. proc tixNoteBook::delete {w child} {
  167.     upvar #0 $w data
  168.  
  169.     if {$child == [$data(w:top) info active]} {
  170.     foreach page $data(windows) {
  171.         if {$page != $child} {
  172.         $w raise $page
  173.         break
  174.         }
  175.     }
  176.     }
  177.  
  178.     tixChainMethod $w delete $child
  179.     $data(w:top) delete $child
  180. }
  181.  
  182. #----------------------------------------------------------------------
  183. # Private methods
  184. #----------------------------------------------------------------------
  185. proc tixNoteBook::Resize {w} {
  186.     upvar #0 $w data
  187.  
  188.     # We have to take care of the size of the tabs so that 
  189.     #
  190.     set rootReq [$data(w:top) geometryinfo]
  191.     set tW [lindex $rootReq 0]
  192.     set tH [lindex $rootReq 1]
  193.  
  194.     set data(pad-x1) 2 
  195.     set data(pad-x2) 2
  196.     set data(pad-y1) [expr $tH + $data(-ipadx) + 1]
  197.     set data(pad-y2) 2
  198.     set data(minW)   [expr $tW]
  199.     set data(minH)   [expr $tH]
  200.  
  201.     # Now that we know data(pad-y1), we can chain the call
  202.     #
  203.     tixChainMethod $w Resize
  204. }
  205.  
  206. proc tixNoteBook::Activate {w x y} {
  207.     upvar #0 $w data
  208.  
  209.     set name [$data(w:top) identify $x $y]
  210.  
  211.     if {$name != {} && [$data(w:top) pagecget $name -state] == "normal" } {
  212.     $data(w:top) activate $name
  213.     tixCallMethod $w raise $name
  214.     }
  215. }
  216.  
  217. proc tixNoteBook::MouseDown {w x y} {
  218.     upvar #0 $w data
  219.  
  220.     focus $data(w:top)
  221.  
  222.     set name [$data(w:top) identify $x $y]
  223.     $data(w:top) focus $name
  224.     set data(w:down) $name
  225. }
  226.  
  227. proc tixNoteBook::MouseUp {w x y} {
  228.     upvar #0 $w data
  229.  
  230.     set name [$data(w:top) identify $x $y]
  231.  
  232.     if {$name != {} && $name == $data(w:down) && [$data(w:top) pagecget $name -s
  233. tate] == "normal" } {
  234.         $data(w:top) activate $name
  235.         tixCallMethod $w raise $name
  236.     } else {
  237.         $data(w:top) focus ""
  238.     }
  239. }
  240.  
  241.  
  242. #----------------------------------------------------------------------
  243. #
  244. # Section for keyboard bindings
  245. #
  246. #----------------------------------------------------------------------
  247.  
  248. proc tixNoteBook::FocusNext {w dir} {
  249.     upvar #0 $w data
  250.  
  251.     if {[$data(w:top) info focus] == {}} {
  252.     set name [$data(w:top) info active]
  253.     $data(w:top) focus $name
  254.  
  255.     if {$name != {}} {
  256.         return
  257.     }
  258.     } else {
  259.     set name [$data(w:top) info focus$dir]
  260.      $data(w:top) focus $name
  261.    }
  262. }
  263.  
  264. proc tixNoteBook::SetFocusByKey {w} {
  265.     upvar #0 $w data
  266.  
  267.     set name [$data(w:top) info focus]
  268.  
  269.     if {$name != {} && [$data(w:top) pagecget $name -state] == "normal"} {
  270.     tixCallMethod $w raise $name
  271.     $data(w:top) activate $name
  272.     }
  273. }
  274.  
  275. #----------------------------------------------------------------------
  276. # Automatic bindings for alt keys
  277. #----------------------------------------------------------------------
  278. proc tixNoteBookFind {w char} {
  279.     global tkPriv
  280.     set char [string tolower $char]
  281.  
  282.     foreach child [winfo child $w] {
  283.     switch [winfo class $child] {
  284.         TixNoteBook {
  285.         set nbframe [$child subwidget nbframe]
  286.         foreach page [$nbframe info pages] {
  287.             set char2 [string index [$nbframe pagecget $page -label] \
  288.             [$nbframe pagecget $page -underline]]
  289.             if {([string compare $char [string tolower $char2]] == 0)||
  290.             ($char == "")} {
  291.             if {[$nbframe pagecget $page -state] != "disabled"} {
  292.                 return "$child $page"
  293.             }
  294.             }
  295.         }
  296.         }
  297.         Frame {
  298.         set match [tixNoteBookFind $child $char]
  299.         if {$match != ""} {
  300.             return $match
  301.         }
  302.         }
  303.     }
  304.     }
  305.     return {}
  306. }
  307.  
  308. proc tixTraverseToNoteBook {w char} {
  309.     if {$char == ""} {
  310.     return
  311.     }
  312.     if {![winfo exists $w]} {
  313.     return
  314.     }
  315.     set list [tixNoteBookFind [winfo toplevel $w] $char]
  316.     if {$list != ""} {
  317.     [lindex $list 0] raise [lindex $list 1]
  318.     }
  319. }
  320.  
  321. #----------------------------------------------------------------------
  322. # Set default class bindings
  323. #----------------------------------------------------------------------
  324.  
  325. bind all <Alt-KeyPress> "+tixTraverseToNoteBook %W %A"
  326. bind all <Meta-KeyPress> "+tixTraverseToNoteBook %W %A"
  327.  
  328.